the 1st

The first ugly attempt…

I created my first dropdown in 2020 & … looking back, I remember it being quite ugly. It was largely my first experience with html, javascript, and css so my end rmarkdown output looked something like the below.

It’s often that speed of development can override ‘feature soundness’. I wouldn’t say this is necessarily a good thing. But - it’s not necessarily a bad thing either. It forces you to focus on the bare bones minimum - that can then be developed further down the road.

# section
<div>
<select id='countrySelector'>
<option val="cleanVal"> Manually defined option one </option>
<option val="...">...</option>
.
.
.
</select>
\\```{r}

data %>% 
  split(.$id) %>% 
  imap(~{
   create_plot() %>% 
   div(id = glue::glue("{.y}CountryOpt"),class="CountryOpt")
  })


\\```
<script>
var selector = document.getElementById("countrySelector")
selector.onchange = function(){
  // logic to hide all of the .CountryOpt charts
  // logic to find the id of the selected chart
  // set the display to show the selected chart
}

</script>

</div>

the second

An improved 2nd attempt

I remember thinking, ‘there’s gotta be an easier way’. I was copying and pasting, manually creating all of the inputs, and duplicating a lot of code.

There’s a joke that coders are ‘lazy’ in that they don’t want to do something twice. In an odd way, it describes a paradigm of coding. Why would you repeat what you’ve already done vs. build on to it?

I took this very minimal starting point and started to build.

My goal was simple, how do I eliminate unnecessary code & duplications?

The first order of business was to generate a random id to ensure that I didn’t run into namespace collisions. This allows us to re-use the same logic without running into duplicate id’s / definitions.

highcharter has a good function for this imho.

highcharter:::random_id

## function (n = 1, length = 10) 
## {
##     source <- c(seq(0, 9), letters)
##     replicate(n, paste0(sample(x = source, size = length, replace = TRUE), 
##         collapse = ""))
## }
## <bytecode: 0x10842c588>
## <environment: namespace:highcharter>

highcharter:::random_id()

## [1] "n7slpekbrs"

# I'd slightly modify it to append a letter at the start (sometimes it produces a number to start) to ensure there were no javascript errors 

paste0(sample(letters,1),highcharter:::random_id())

## [1] "z5cnos9jjoe"

considerations / drawbacks

Speed / render / redraw

third attempt

Simplifying and finally cracking

# https://github.com/zac-garland/highchart.extensions/blob/master/R/add_multi_drop.R
add_multi_drop <- function(hc, selectors, selected = NULL) {
  # first we create a random id to ensure that if used multiple times, each selector / chart combo has a unique id
  rand_id_begin <- paste(sample(letters, 3, replace = FALSE),
    sample(letters, 4, replace = FALSE),
    sample(letters, 3, replace = FALSE),
    collapse = ""
  ) |> stringr::str_remove_all(" ")

  # next we generate the potential list options available in the chart (to ensure that we aren't passing in multiple data sets or trying to attach the data again to the web document)
  list_opts <- purrr::map(setNames(selectors, selectors), ~ {
    select_name <- .x
    hc$x$hc_opts$series |>
      purrr::map(~ {
        purrr::map(purrr::pluck(.x, "data"), ~ {
          purrr::pluck(.x, select_name)
        }) |>
          unlist()
      }) |>
      unlist() |>
      unique()
  })

  # generate the select html input elements with their corresponding options
  select_options <- list_opts |>
    purrr::imap(~ {
      htmltools::tags$select(
        style = "display:inline-block",
        id = paste0(.y, rand_id_begin),
        purrr::map(.x, ~ {
          if ((!is.null(selected) & .x %in% selected)) {
            htmltools::tags$option(value = ., ., `selected` = TRUE)
          } else {
            htmltools::tags$option(value = ., .)
          }
        })
      )
    })

  # generate variable declaration statement in javascript using R string interpolation (comparable to es7 `this var: ${var}`)
  names(list_opts) |>
    purrr::map_chr(~ {
      glue::glue("var select_{paste0(.x, rand_id_begin)} = document.getElementById('{paste0(.x, rand_id_begin)}');")
    }) |>
    paste(collapse = "") -> var_declaration

  # generate shared javascript filter (each chart should be aware of multiple inputs - and share the filter between onchange events)
  names(list_opts) |>
    purrr::map_chr(~ {
      glue::glue("obj.{.x} == select_{paste0(.x, rand_id_begin)}.value")
    }) |>
    paste(collapse = " & ") -> filter_declaration

  # generate the onchange events to monitor each of the inputs
  names(list_opts) |>
    purrr::map_chr(~ {
      glue::glue("select_{paste0(.x, rand_id_begin)}.onchange = updateChart;")
    }) |>
    paste(collapse = "") -> onchg_events

# create the javascript function for highcharts events, adding in the variable declaration, filters, and events generated from previous steps
  
js_fun <- "function(){{
  var this_chart = this;
  // create a cloned data set (to avoid highcharts mutate behavior)
  const cloneData = (sample) => {{ return JSON.parse(JSON.stringify(sample));}}
  // initialize empty array 
  const init_data = [];
  // loop over chart series and add to data array
  this_chart.options.series.map((series,index)=>{{
    init_data[index] = cloneData(series.data);
  }})

  // declare variables
  {var_declaration}

  // create shared updateChart function
  function updateChart(){{
      // map the series data to filter based on inputs
      init_data.map((series,index)=>{{
      new_data = series.filter(function(obj){{
        return {filter_declaration}
        }});
      // only draw if data is available post filter
      if(new_data.length>0){{
        this_chart.series[index].setData(new_data);
      }}

      }})
    // redraw chart
    this_chart.reflow();

  }}
  // add on change monitor events for dropdowns
  {onchg_events}
  // updateChart (for first run)
  updateChart();
}}"

# add javascript function as an onload event (so we filter down the data in the first view)
  highcharter::hc_chart(hc,
    events = list(
      load = highcharter::JS(glue::glue(js_fun))
    )
  ) |>
    htmltools::tagList(
      select_options, . # create a html fragment including the dropdowns and chart 
    ) |>
    htmltools::browsable() # create a browsable option (shows chart in rstudio or in render)
}

tidy_employment_data <- fpp3::us_employment |>
  janitor::clean_names() |>
  as_tibble() |>
  filter(!str_detect(title,":")) |>
  rename(value = employed) |>
  mutate(month = lubridate::as_date(month)) |>
  group_by(title) |>
  mutate(yoy = value/lag(value,12)-1,
         `Three year comp` = value/lag(value,36)-1) |>
  gather(key,value,value:`Three year comp`) 

tidy_employment_data |>
  mutate(month = datetime_to_timestamp(month)) |> # for highcharts date format
  highcharter::hchart("line", highcharter::hcaes(month, value, name = title)) |>
  hc_xAxis(type = "datetime") |>
  add_multi_drop(
    selectors = c("title", "key"),
    selected = c("Total Private", "Three year comp")
  )